PC-SIG Library 8

home *** CD-ROM | disk | FTP | other *** search

/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 201_300 / disk0214 / transfer.bas < prev

Wrap

BASIC Source File | 1983-03-10 | 17.1 KB | 610 lines

3 DEFDBL X 4 DEFINT A-W,Y-Z 5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30),IOPT(30) 10 DIM X$(30),Y$(30) 13 DIM L(15),NREC(15),Z$(30) 14 DIM X(30),CK$(30),SN$(30),SFN(10),DTOPT(10) 16 DIM LEND(30),CL(30) 17 DIM FTA(10),ATF(10),BTF(10),IMAX(10) 18 DIM SU%(40),S!(30),SUM#(40) 22 DIM ORFLG(10),D(10),TFN(10),FLDTCT(10,30,1),KTSUM(30),SUMFN(30) 23 DIM SUMF(10,30),KTSUMAF(30),SAFFN(30),SAFADD(10,30),SAFACCTO(10,30) 24 DIM SAFFLDN(10,30) 25 DIM S#(30) 26 DIM MAX(10),Z%(30),SU#(30),D#(30),EFN(10,30) 35 DIM K$(80) 42 DIM MAXK(30),SUMRN(10,30),SUMFLDN(10,30),MAXSAF(5) 44 DIM SUMAFOPT(10),SUMOPT(10),RNTNBOPT(10),DY(10),FLDTC(10,30,1) 46 DIM SUMFLD(10,30) 60 DIM SAF#(3,200) 61 CH = 29: PRINT FRE(0) 62 GOSUB 50000 70 NE = 0 80 GOSUB 10000 1000 GOTO 18000 2300 REM ************** DISK SELECTION *************** 2302 IF HDISK = 2 THEN GOSUB 13000 2303 IF HDISK = 2 THEN GOTO 2360 2304 PRINT "" 2305 PRINT "************ WHICH DISK DRIVE IS THE FILE ON **************" 2310 PRINT "" 2315 PRINT " 1 - DISK DRIVE A" 2320 PRINT " 2 - DISK DRIVE B" 2325 PRINT " 3 - DISK DRIVE C" 2330 PRINT " 4 - DISK DRIVE D" 2335 PRINT "" 2340 PRINT "*********** ENTER THE NUMBER THEN PRESS RETURN ************" 2345 GOSUB 14000 2347 IF DT# < 0 OR DT#>4 GOTO 2345 2350 T = DT# 2355 ON T GOTO 2360,2370,2380,2390 2360 T$ = F$(A) 2365 GOTO 2490 2370 T$ = "B:"+F$(A) 2375 GOTO 2490 2380 T$ = "C:"+F$(A) 2385 GOTO 2490 2390 T$ = "D:"+F$(A) 2490 RETURN 2500 REM ******* OPEN FILE SUBROUTINE ******* 2503 CLOSE #1 2505 OPEN "R",#1,T$,L(A) 2507 D = 0 2510 FOR T = 1 TO NREC(A) 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T) 2530 D = D + FL(A,T) 2540 NEXT T 2543 GOSUB 7800 2545 RETURN 2550 REM ******* OPEN SECOND FILE ******* 2553 CLOSE #2 2555 OPEN "R",#2,T$,L(B) 2557 D = 0 2560 FOR T = 1 TO NREC(B) 2565 FIELD #2,D AS DY$,FL(B,T) AS Y$(T) 2570 D = D + FL(B,T) 2575 NEXT T 2578 RETURN 2580 REM ******* OPEN THIRD FILE ******* 2582 PRINT C,F$(C),L(C) 2584 OPEN "R",#2,F$(C),L(C) 2586 D = 0 2588 FOR T = 1 TO NREC(C) 2590 FIELD #2,D AS DY$,FL(C,T) AS Z$(T) 2592 D = D + FL(C,T) 2594 NEXT T 2596 RETURN 7800 MRN = LOF(1)/ L(A) 7805 REM MRN = INT(MRN) 7810 RETURN 7900 REM ***** LOF 7910 MRN2 = LOF(3)/82 7920 RETURN 7950 REM ******* LOF 7960 MRNS = LOF(B)/L(B) 7970 RETURN 10000 REM ************* READ SUBROUTINE ************* 10004 GOSUB 10900 10010 OPEN "I",#1,"FFILE" 10020 INPUT #1,MAXF 10030 FOR A = 1 TO MAXF 10040 INPUT #1,A,F$(A),NREC(A),L(A) 10050 FOR N = 1 TO NREC(A) 10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N) 10070 IF FTY(A,N) = 2 THEN INPUT #1,D,D 10080 NEXT N 10090 NEXT A 10100 CLOSE #1 10110 RETURN 10900 REM ************* PUT DISK IN DRIVE SUB 10905 IF HDISK = 2 THEN RETURN 10910 GOSUB 13000 10920 PRINT " ******** PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE *********" 10930 PRINT "" 10940 PRINT " THEN PRESS ANY KEY TO CONTINUE " 10950 PRINT "" 10960 PRINT " If the program data disk is already in the default disk drive then" 10965 PRINT " just press any key to continue." 10970 PRINT "" 10990 IF INKEY$ = "" GOTO 10990 10995 RETURN 11000 REM ******** LOAD KEYLIST ********* 11010 RETURN 13000 REM ********* CLEAR SCREEN 13010 CLS 13020 RETURN 13100 REM ********* LOCATE 13110 LOCATE LI,1 13120 RETURN 13200 FOR T% = 1 TO 80 13210 PRINT CHR$(8); 13220 NEXT T% 13222 FOR T% = 1 TO 24 13223 PRINT CHR$(11); 13224 NEXT T% 13225 LI = LI - 1 13230 FOR T% = 1 TO LI 13240 PRINT CHR$(0) 13250 NEXT T% 13590 RETURN 13600 REM ****** CHECK FOR ASC0 13610 S4$ = INKEY$ 13620 C2 = ASC(S4$) 13630 IF C2 = 83 THEN C = 1 13640 IF C2 = 82 THEN C = 6 13650 IF C2 = 75 THEN C = 19 13660 IF C2 = 77 THEN C = 4 13670 RETURN 14000 REM ******* INTEGER LESS THEN 100 CHECK ******** 14010 MAX = 2 14020 ACT$ = "1234567890=<>^" 14023 IF NE = 0 THEN ACT$ = "1234567890" 14025 PRINT ">__<"; 14030 GOTO 14500 14100 REM ******* INTEGER ******* 14110 MAX = 8 14120 ACT$ = "1234567890-+,=<>^" 14123 IF NE = 0 THEN ACT$ = "1234567890-+," 14125 PRINT ">________<"; 14130 GOTO 14500 14200 REM ******* SINGLE PRECISION ******* 14210 MAX = 10 14220 ACT$ = "1234567890-+,.%$=<>^" 14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 14225 PRINT ">__________<"; 14230 GOTO 14500 14300 REM ******* DOUBLE PRECISION ******* 14310 MAX = 20 14320 ACT$ = "1234567890-+,.%$=<>^" 14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$" 14325 PRINT ">____________________<"; 14330 GOTO 14500 14500 REM ********** NUMBER CHECK ********** 14505 A$ = "" 14510 K$(20) = " " 14515 KTMAX = 0 14520 FOR T9 = 1 TO MAX 14525 K$(T9) = " " 14530 NEXT T9 14535 DIG$ = "1234567890." 14540 DOTFLG = 0 14541 T2 = MAX + 1 14542 FOR T6 = 1 TO T2 14544 PRINT CHR$(CH); 14546 NEXT T6 14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550 14560 KT = 0 14565 REM *********** CHECK ALFANUMERIC INPUT FOR LENGTH *********** 14570 KT = KT + 1 14575 REM 14580 W$ = INKEY$ 14585 IF W$ = "" GOTO 14580 14590 C = ASC(W$) 14593 IF C = 0 THEN GOSUB 13600 14595 IF C = 13 GOTO 14660 14600 IF C = 17 OR C = 8 GOTO 14860 14605 IF C = 19 GOTO 14690 14610 IF C = 4 GOTO 14710 14615 IF C = 6 GOTO 14730 14620 IF C = 1 GOTO 14790 14625 IF KT > MAX GOTO 14575 14630 IF INSTR(ACT$,W$) = 0 GOTO 14890 14635 K$(KT) = W$ 14645 PRINT K$(KT); 14650 IF KT > KTMAX THEN KTMAX = KT 14655 GOTO 14570 14660 REM ********** RETURN ********** 14670 FOR T9 = 1 TO KTMAX 14675 A$ = A$ + K$(T9) 14680 NEXT T9 14681 IF KTMAX = 0 THEN PRINT "1" 14682 IF KTMAX = 0 THEN DT# = 1 14683 IF KTMAX = 0 THEN RETURN 14684 PRINT "" 14685 GOTO 14905 14690 REM ********* MOVE CURSE BACK ******** 14695 IF KT = 1 GOTO 14575 14700 KT = KT - 1 14703 PRINT CHR$(CH); 14705 GOTO 14575 14710 REM ********* MOVE CURSER FORWARD ********* 14715 IF KT >= MAX GOTO 14575 14716 IF KT > (KTMAX + 1) GOTO 14575 14718 PRINT K$(KT); 14720 KT = KT + 1 14725 GOTO 14575 14730 REM ********** INSERT *********** 14733 IF KT > KTMAX GOTO 14575 14735 X9 = MAX 14740 WHILE X9 > KT 14745 X9 = X9 - 1 14750 K$(X9 + 1) = K$(X9) 14755 WEND 14760 K$(KT) = " " 14767 KTMAX = KTMAX + 1 14769 IF KTMAX > MAX THEN KTMAX = MAX 14770 FOR T9 = KT TO KTMAX 14775 PRINT K$(T9); 14780 NEXT T9 14781 T6 = (KTMAX - KT) + 1 14782 FOR T7 = 1 TO T6 14783 PRINT CHR$(CH); 14784 NEXT T7 14785 GOTO 14575 14790 REM ********** DELETE *********** 14793 IF KT > KTMAX GOTO 14575 14794 IF KTMAX = 1 GOTO 14575 14795 K$(MAX + 1) = "" 14800 X9 = KT 14805 WHILE X9 <= MAX 14810 K$(X9) = K$(X9 + 1) 14815 X9 = X9 + 1 14820 WEND 14830 KTMAX = KTMAX - 1 14835 FOR T9 = KT TO KTMAX 14840 PRINT K$(T9); 14845 NEXT T9 14850 PRINT "_"; 14851 T7 = (KTMAX - KT) + 2 14852 FOR T8 = 1 TO T7 14853 PRINT CHR$(CH); 14854 NEXT T8 14855 GOTO 14575 14860 REM ********* BACKSPACE ******** 14865 IF KT = 1 GOTO 14575 14870 KT = KT - 1 14875 PRINT CHR$(CH); 14877 K$(KT) = " " 14880 PRINT "_"; 14883 PRINT CHR$(CH); 14885 GOTO 14575 14890 REM ******* INPUT NOT ACCEPTABLE ******** 14895 PRINT CHR$(7); 14900 GOTO 14580 14905 REM ********* CLEAR STRINGS ******** 14910 MAX = LEN(A$) 14915 D2$ = "" 14920 D1$ = "" 14925 DFLG = 0 14930 FOR Q93 = 1 TO MAX 14935 R$ = MID$(A$,Q93,1) 14940 IF INSTR(DIG$,R$) = 0 GOTO 14975 14945 IF R$ = "." OR DFLG = 1 GOTO 14965 14950 IF DFLG = 1 GOTO 14965 14955 D2$ = D2$ + R$ 14960 GOTO 14975 14965 D1$ = D1$ + R$ 14970 DFLG = 1 14975 NEXT Q93 14980 DA# = VAL(D2$) 14985 D1# = VAL(D1$) 14990 DT# = DA# + D1# 14995 IF K$(1) = "-" THEN DT# = -DT# 14997 RETURN 16010 PRINT "*********** MAKE SURE YOUR PRINTER IS ON **************" 16020 PRINT "" 16030 PRINT "******************** WITH PAPER ***********************" 16040 PRINT "" 16050 PRINT "********** PRESS ANY KEY TO START PRINTING ************" 16055 PRINT "" 16057 PRINT " ******* PRESS THE LETTER A TO ABORT *******" 16070 T$ = INKEY$ 16073 IF T$ = "" GOTO 16070 16075 PRINT T$ 16090 RETURN 16200 REM ********* PRINT OUT FIELDS 16205 T2 = 1 16210 FOR T = 1 TO NREC(A) 16220 PRINT TAB(T2) T;"-";FLDN$(A,T); 16230 IF T MOD 3 = 0 THEN PRINT "" 16235 IF T MOD 3 = 0 THEN T2 = -25 16237 T2 = T2 + 26 16340 NEXT T 16350 RETURN 18000 REM ********** TRANSFER MENU ************** 18005 IF DTFLG >< 1 THEN GOSUB 19000 18007 GOSUB 13000 18010 PRINT "**************** TRANSFER MENU ******************" 18020 PRINT "" 18025 PRINT " 0 - EXIT THE PROGRAM" 18030 FOR N = 1 TO MAXS 18040 PRINT " ";N;"- ";SN$(N) 18050 NEXT N 18060 PRINT "" 18070 PRINT "******* ENTER THE NUMBER AND PRESS RETURN *******" 18075 GOSUB 14000 18076 IF DT# <0 OR DT# >MAXS GOTO 18075 18078 IF DT# = 0 THEN GOTO 51000 18080 SOPT = DT# 18085 GOSUB 13000 18090 A = SFN(SOPT) 18092 PRINT F$(A),"SOURCE FILE" 18094 GOSUB 2300 18096 GOSUB 2500 18098 IF DTOPT(SOPT) = 1 THEN GOSUB 21000 18099 GOSUB 13000 18100 PRINT "" 18110 PRINT "***** WHAT RECORD NUMBER DO YOU WANT TO START AT *****" 18120 PRINT "" 18130 PRINT "********* ENTER THE NUMBER THEN PRESS RETURN *********" 18135 GOSUB 14200 18136 IF DT# <1 OR DT# >10000 GOTO 18135 18140 RNSS = DT# 18200 PRINT "" 18202 GOSUB 7800 18204 PRINT "THE HIGHEST NUMBERED RECORD IS ";MRN 18210 PRINT "******** WHICH IS THE LAST RECORD YOU WANT TO TRANSFER ********" 18220 PRINT "" 18230 PRINT "************* ENTER THE NUMBER THEN PRESS RETURN **************" 18235 GOSUB 14200 18236 IF DT# <1 OR DT# >MRN GOTO 18235 18240 RNSF = DT# 18250 IF RNSF > MRN GOTO 18204 18300 SFN = SFN(SOPT) 18500 GOTO 20000 19000 REM ************ OPEN FOR INPUT ************** 19005 GOSUB 10900 19010 OPEN "I",#2,"TFER" 19020 INPUT #2,MAXS 19030 FOR S = 1 TO MAXS 19040 D = 1 19050 INPUT #2,DTOPT(S),SUMOPT(S),SUMAFOPT(S),SN$(S),SFN(S) 19060 IF DTOPT(S) = 2 GOTO 19170 19070 INPUT #2,RNTNBOPT(S),D(S),TFN(S),DY(S) 19080 TFN = TFN(S) 19090 FOR N = 1 TO DY(S) 19100 INPUT #2,FLDTC(S,N,D) 19110 IF FLDTC(S,N,D) = 1 GOTO 19130 19120 INPUT #2,FLDTCT(S,N,D) 19130 NEXT N 19140 IF D = 2 GOTO 19170 19150 IF D(S) = 2 THEN D = 2 19160 IF D(S) = 2 GOTO 19090 19170 IF SUMOPT(S) = 2 GOTO 19220 19180 INPUT #2,KTSUM(S),SUMFN(S) 19190 FOR K = 1 TO KTSUM(S) 19200 INPUT #2,SUMF(S,K),SUMRN(S,K),SUMFLDN(S,K) 19210 NEXT K 19220 IF SUMAFOPT(S) = 2 GOTO 19270 19230 INPUT #2, KTSUMAF(S),SAFFN(S) 19240 FOR K = 1 TO KTSUMAF(S) 19250 INPUT #2,SAFADD(S,K),SAFACCTO(S,K),SAFFLDN(S,K),DY 19260 NEXT K 19270 NEXT S 19280 CLOSE #2 19285 DTFLG = 1 19290 RETURN 20000 REM ****** DATA TRANSFER PROGRAM ****** 20095 REM ***** INITIALIZE SUMS TO ZERO ***** 20100 GOSUB 20900 20105 PRINT "*** INITIALIXE SUMS 20110 REM *** OPEN SOURCE FILE **** 20112 GOSUB 13000 20140 REM ** IF DTOPT(SOPT) = 1 THEN GOSUB 21000 20150 REM ******* START READING LOOP ********** 20160 FOR RN = RNSS TO RNSF 20180 GET #1,RN 20195 REM ******* CONVERT STRINGS TO INTEGERS 20200 GOSUB 21066 20205 PRINT "*** READING RECORD NUMBER ";RN 20210 REM ******* RECORD NUMBERING 20220 IF DTOPT(SOPT) = 1 THEN GOSUB 21700 20230 REM ***** TRANSFER DATA 20240 IF DTOPT(SOPT) = 1 THEN GOSUB 21900 20250 REM ***** ADD ACCORDING TO FIELDS 20260 IF SUMOPT(SOPT) = 1 THEN GOSUB 24000 20270 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 24100 20300 NEXT RN 20500 REM ****** RESUME FROM ON ERROR 20510 REM ****** MOVE FIELDS TO FILE 20520 IF SUMOPT(SOPT) = 1 THEN GOSUB 25600 20530 IF SUMAFOPT(SOPT) = 1 THEN GOSUB 25800 20590 CLOSE 20600 GOTO 18000 20900 REM ****** CLEAR VARIABLES ****** 20910 FOR N = 1 TO KTSUM 20920 SUM#(N) = 0 20930 NEXT N 20950 IF SUMAFOPT = 2 GOTO 20998 20960 FOR P = 1 TO KTSUMAF 20970 FOR N = 1 TO MAX(P) 20980 SAF#(P,N) = 0 20990 NEXT N 20995 NEXT P 20998 RETURN 21000 REM *********** DATA TRANSFER OPTION ********** 21005 TFN = TFN(SOPT) 21010 B = TFN 21015 GOSUB 13000 21017 PRINT F$(B)," TARGET FILE " 21018 AHLD = A 21019 A = B 21020 GOSUB 2300 21030 GOSUB 2550 21032 A = AHLD 21040 RETURN 21066 FOR K = 1 TO NREC(A) 21068 REM ******** CONVERT EACH RECORD TO DECIMAL ********** 21070 ON FTY(A,K) GOTO 21100,21200,21300,21400,21400 21100 Z$(K) = X$(K) 21110 GOTO 21500 21150 REM ******* START READING LOOP ********** 21200 Z%(K) = CVI(X$(K)) 21205 SU#(K) = Z%(K) 21210 GOTO 21500 21300 S!(K) = CVS(X$(K)) 21305 SU#(K) = S!(K) 21310 GOTO 21500 21400 D#(K) = CVD(X$(K)) 21405 SU#(K) = D#(K) 21410 GOTO 21500 21500 NEXT K 21510 RETURN 21590 REM ******* GET SECOND FILE ********** 21595 REM ***** OPEN B ON START UP **** 21600 IF N <> RNSS GOTO 21700 21605 FLG = 1 21610 FLDOPT = 2 21620 B = TFN 21630 GOSUB 2300 21700 REM ***** RECORD NUMBERING 21705 RNTNBOPT = RNTNBOPT(SOPT) 21710 IF RNTNBOPT = 0 GOTO 21800 21715 REM ****** B RECORD NUMBER = TO A FIELD ****** 21720 RN2 = SU#(RNTNBOPT) 21730 RETURN 21790 REM ****** B RECORD NUMBER INCREMENTS FROM 1 ******* 21800 RN2 = RN 21810 RETURN 21900 REM ****** GET SECOND RECORD ****** 21905 PRINT "TRANSFERING TO RECORD ";RN2 21910 GET #2,RN2 22000 FOR R = 1 TO NREC(B) 22005 REM ***** NO TRASFER ***** 22010 IF FLDTC(SOPT,R,1) = 1 GOTO 23900 22020 IF FTY(B,R) <> 1 GOTO 22100 22030 T = FLDTC(SOPT,R,1) - 1 22040 LSET Y$(R) = Z$(T) 22050 GOTO 23900 22095 REM ***** JUST REPLACE ***** 22100 IF FLDTCT(SOPT,R,1) <> 2 GOTO 22200 22105 T = FLDTC(SOPT,R,1) - 1 22110 LSET Y$(R) = Z$(T) 22120 GOTO 23900 22200 ON FTY(B,R) GOTO 23900,22210,22300,22400,22400 22205 REM ***** INTEGER ***** 22210 I%=CVI(Y$(R)) 22215 T = FLDTC(SOPT,R,1) - 1 22218 D# = SU#(T) 22220 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D# 22230 I% = I% + D# 22240 LSET Y$(R) = MKI$(I%) 22250 GOTO 23900 22300 REM ** SINGLE PRECISION ** 22310 I!=CVS(Y$(R)) 22315 T = FLDTC(SOPT,R,1) - 1 22318 D# = SU#(T) 22320 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D# 22330 I! = I! + D# 22340 LSET Y$(R) = MKS$(I!) 22350 GOTO 23900 22400 REM ** DOUBLE PRECISION ** 22407 Y$ = Y$(R) 22410 I#=CVD(Y$) 22415 T = FLDTC(SOPT,R,1) - 1 22416 D# = SU#(T) 22420 IF FLDTCT(SOPT,R,1) = 3 THEN D# = -1 * D# 22430 I# = I# + D# 22440 LSET Y$(R) = MKD$(I#) 22450 GOTO 23900 22990 REM ****** FINISH TRANSFER LOOP ****** 23900 NEXT R 23910 PUT #2,RN2 23912 RETURN 24000 REM ******** SUM OPTION ******* 24010 FOR P = 1 TO KTSUM(SOPT) 24020 T = SUMF(SOPT,P) 24030 SUM#(P) = SUM#(P) + SU#(T) 24040 NEXT P 24050 RETURN 24100 REM ***** ADD ACCORDING TO FIELDS ***** 24110 IF SUMAFOPT = 2 GOTO 24285 24120 FOR P = 1 TO KTSUMAF(SOPT) 24130 T = SAFADD(SOPT,P) 24140 F = SAFACCTO(SOPT,P) 24150 I = SU#(F) 24155 IF I > MAXSAF(P) THEN MAXSAF(P) = I 24160 SAF#(P,I) = SAF#(P,I) + SU#(T) 24170 NEXT P 24285 RETURN 25600 REM ****** MOVE SUMS TO FILES ****** 25620 CLOSE 25630 B = SUMFN(SOPT) 25645 GOSUB 13000 25647 PRINT F$(B),"FILE FOR SUMS" 25648 AHLD = A 25649 A = B 25650 GOSUB 2300 25660 GOSUB 2550 25665 A = AHLD 25670 FOR P = 1 TO KTSUM(SOPT) 25700 RN = SUMRN(SOPT,P) 25710 GET 2,RN 25720 T = SUMFLDN(SOPT,P) 25725 S# = SUM#(P) 25727 PRINT "SUM";S#;" FIELD ";T 25730 ON FTY(B,T) GOSUB 25790,25772,25780,25790,25790 25750 PUT #2,RN 25760 NEXT P 25770 RETURN 25772 LSET Y$(T) = MKI$(S#) 25775 RETURN 25780 LSET Y$(T) = MKS$(S#) 25785 RETURN 25790 LSET Y$(T) = MKD$(S#) 25795 RETURN 25800 REM ******* PUT SUM ACCORDING TO FIELDS IN FILES ******* 25810 CLOSE 25820 B = SAFFN(SOPT) 25823 GOSUB 13000 25825 PRINT F$(B),"FILE FOR SUMS ACCORDINT TO FIELDS " 25827 AHLD = A 25828 A = B 25830 GOSUB 2300 25833 A = AHLD 25835 GOSUB 2550 25850 FOR P = 1 TO KTSUMAF(SOPT) 25852 T = SAFFLDN(SOPT,P) 25860 FOR J = 1 TO MAXSAF(P) 25865 S# = SAF#(P,J) 25870 GET #2,J 25880 ON FTY(B,T) GOSUB 25984,25984,25990,25995,25995 25890 PUT #2,J 25895 PRINT P,J,S#,A,T 25900 NEXT J 25910 NEXT P 25980 CLOSE 25982 RETURN 25984 LSET Y$(T) = MKI$(S#) 25986 RETURN 25990 LSET Y$(T) = MKS$(S#) 25992 RETURN 25995 LSET Y$(T) = MKD$(S#) 25997 RETURN 26000 REM ******* ON ERROR ROUTINE ************ 26100 EFLG = 1 26200 PRINT "********** END OF FILE ***********" 26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****" 26204 IF INKEY$ = "" GOTO 26204 26500 REM ********* ON ERROR SUBROUTINE *********** 26600 PRINT "********** END OF FILE ***********" 26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****" 26620 IF INKEY$ = "" GOTO 26620 26635 EFLG = 1 26640 RETURN 26800 REM ********** ON ERROR GOTO ************** 26900 PRINT "************ RECORD NOT FOUND *************" 50000 REM ********** INTRO 50010 GOSUB 13000 50100 PRINT " T R A N S F E R P R O G R A M 3.0 " 50105 PRINT "" 50110 PRINT " Copyright 1984 by Potomac Pacific Engineering Inc." 50120 PRINT "" 50130 PRINT "This program is licensed FREE to all users with some restrictions" 50165 PRINT " See the manual for more information on the license." 50167 PRINT "" 50950 PRINT "****************** PRESS ANY KEY TO CONTINUE *******************"; 50960 IF INKEY$ = "" GOTO 50960 50970 RETURN 51000 REM ******** EXIT 51100 GOSUB 13000 51105 GOSUB 13000 51110 PRINT " -BYE, Have a nice day 51120 END 51200 PRINT "BYE - Have a nice day " 51300 END SUB 13000 51105 GOSUB 13000 51110 PRINT " -BYE, Have a nice day 51120 END 51